home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / share / perl5 / Net / CIDR.pm next >
Encoding:
Perl POD Document  |  2009-02-11  |  22.7 KB  |  1,246 lines
  1. # Net::CIDR
  2. #
  3. # Copyright 2001-2009 Sam Varshavchik.
  4. #
  5. # with contributions from David Cantrell.
  6. #
  7. # This program is free software; you can redistribute it
  8. # and/or modify it under the same terms as Perl itself.
  9. #
  10. # $Revision: 1.19 $
  11.  
  12. package Net::CIDR;
  13.  
  14. require 5.000;
  15. #use strict;
  16. #use warnings;
  17.  
  18. require Exporter;
  19. # use AutoLoader qw(AUTOLOAD);
  20. use Carp;
  21.  
  22. use Math::BigInt;
  23.  
  24. @ISA = qw(Exporter);
  25.  
  26. # Items to export into callers namespace by default. Note: do not export
  27. # names by default without a very good reason. Use EXPORT_OK instead.
  28. # Do not simply export all your public functions/methods/constants.
  29.  
  30. # This allows declaration    use Net::CIDR ':all';
  31. # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
  32. # will save memory.
  33. %EXPORT_TAGS = ( 'all' => [ qw( range2cidr
  34.                     cidr2range
  35.                     cidr2octets
  36.                     cidradd
  37.                     cidrlookup
  38.                     cidrvalidate
  39.                     addr2cidr
  40.                                     addrandmask2cidr
  41.                     ) ] );
  42.  
  43. @EXPORT_OK = ( qw( range2cidr
  44.                cidr2range
  45.                cidr2octets
  46.                cidradd
  47.                cidrlookup
  48.                cidrvalidate
  49.                addr2cidr
  50.                        addrandmask2cidr
  51.                ));
  52.  
  53. @EXPORT = qw(
  54.     
  55. );
  56.  
  57. $VERSION = "0.13";
  58.  
  59. 1;
  60.  
  61.  
  62. =pod
  63.  
  64. =head1 NAME
  65.  
  66. Net::CIDR - Manipulate IPv4/IPv6 netblocks in CIDR notation
  67.  
  68. =head1 SYNOPSIS
  69.  
  70.     use Net::CIDR;
  71.  
  72.     use Net::CIDR ':all';
  73.  
  74.     print join("\n",
  75.           Net::CIDR::range2cidr("192.68.0.0-192.68.255.255",
  76.                         "10.0.0.0-10.3.255.255"))
  77.            . "\n";
  78.     #
  79.     # Output from above:
  80.     #
  81.     # 192.68.0.0/16
  82.     # 10.0.0.0/14
  83.  
  84.     print join("\n",
  85.           Net::CIDR::range2cidr(
  86.         "dead:beef::-dead:beef:ffff:ffff:ffff:ffff:ffff:ffff"))
  87.                . "\n";
  88.  
  89.     #
  90.     # Output from above:
  91.     #
  92.     # dead:beef::/32
  93.  
  94.     print join("\n",
  95.          Net::CIDR::range2cidr("192.68.1.0-192.68.2.255"))
  96.                   . "\n";
  97.     #
  98.     # Output from above:
  99.     #
  100.     # 192.68.1.0/24
  101.     # 192.68.2.0/24
  102.  
  103.     print join("\n", Net::CIDR::cidr2range("192.68.0.0/16")) . "\n";
  104.     #
  105.     # Output from above:
  106.     #
  107.     # 192.68.0.0-192.68.255.255
  108.  
  109.     print join("\n", Net::CIDR::cidr2range("dead::beef::/46")) . "\n";
  110.     #
  111.     # Output from above:
  112.     #
  113.     # dead:beef::-dead:beef:3:ffff:ffff:ffff:ffff:ffff
  114.  
  115.     @list=("192.68.0.0/24");
  116.     @list=Net::CIDR::cidradd("192.68.1.0-192.68.1.255", @list);
  117.  
  118.     print join("\n", @list) . "\n";
  119.     #
  120.     # Output from above:
  121.     #
  122.     # 192.68.0.0/23
  123.  
  124.     print join("\n", Net::CIDR::cidr2octets("192.68.0.0/22")) . "\n";
  125.     #
  126.     # Output from above:
  127.     #
  128.     # 192.68.0
  129.     # 192.68.1
  130.     # 192.68.2
  131.     # 192.68.3
  132.  
  133.     print join("\n", Net::CIDR::cidr2octets("dead::beef::/46")) . "\n";
  134.     #
  135.     # Output from above:
  136.     #
  137.     # dead:beef:0000
  138.     # dead:beef:0001
  139.     # dead:beef:0002
  140.     # dead:beef:0003
  141.  
  142.     @list=("192.68.0.0/24");
  143.     print Net::CIDR::cidrlookup("192.68.0.12", @list);
  144.     #
  145.     # Output from above:
  146.     #
  147.     # 1
  148.  
  149.     @list = Net::CIDR::addr2cidr("192.68.0.31");
  150.     print join("\n", @list);
  151.     #
  152.     # Output from above:
  153.     #
  154.     # 192.68.0.31/32
  155.     # 192.68.0.30/31
  156.     # 192.68.0.28/30
  157.     # 192.68.0.24/29
  158.     # 192.68.0.16/28
  159.     # 192.68.0.0/27
  160.     # 192.68.0.0/26
  161.     # 192.68.0.0/25
  162.     # 192.68.0.0/24
  163.     # 192.68.0.0/23
  164.     # [and so on]
  165.  
  166.     print Net::CIDR::addrandmask2cidr("195.149.50.61", "255.255.255.248")."\n";
  167.     #
  168.     # Output from above:
  169.     #
  170.     # 195.149.50.56/29
  171.  
  172. =head1 DESCRIPTION
  173.  
  174. The Net::CIDR package contains functions that manipulate lists of IP
  175. netblocks expressed in CIDR notation.
  176. The Net::CIDR functions handle both IPv4 and IPv6 addresses.
  177.  
  178. =head2 @cidr_list=Net::CIDR::range2cidr(@range_list);
  179.  
  180. Each element in the @range_list is a string "start-finish", where
  181. "start" is the first IP address and "finish" is the last IP address.
  182. range2cidr() converts each range into an equivalent CIDR netblock.
  183. It returns a list of netblocks except in the case where it is given
  184. only one parameter and is called in scalar context.
  185.  
  186. For example:
  187.  
  188.     @a=Net::CIDR::range2cidr("192.68.0.0-192.68.255.255");
  189.  
  190. The result is a one-element array, with $a[0] being "192.68.0.0/16".
  191. range2cidr() processes each "start-finish" element in @range_list separately.
  192. But if invoked like so:
  193.  
  194.     $a=Net::CIDR::range2cidr("192.68.0.0-192.68.255.255");
  195.  
  196. The result is a scalar "192.68.0.0/16".
  197.  
  198. Where each element cannot be expressed as a single CIDR netblock
  199. range2cidr() will generate as many CIDR netblocks as are necessary to cover
  200. the full range of IP addresses.  Example:
  201.  
  202.     @a=Net::CIDR::range2cidr("192.68.1.0-192.68.2.255");
  203.  
  204. The result is a two element array: ("192.68.1.0/24","192.68.2.0/24");
  205.  
  206.     @a=Net::CIDR::range2cidr(
  207.            "d08c:43::-d08c:43:ffff:ffff:ffff:ffff:ffff:ffff");
  208.  
  209. The result is an one element array: ("d08c:43::/32") that reflects this
  210. IPv6 netblock in CIDR notation.
  211.  
  212. range2cidr() does not merge adjacent or overlapping netblocks in
  213. @range_list.
  214.  
  215. =head2 @range_list=Net::CIDR::cidr2range(@cidr_list);
  216.  
  217. The cidr2range() functions converts a netblock list in CIDR notation
  218. to a list of "start-finish" IP address ranges:
  219.  
  220.     @a=Net::CIDR::cidr2range("10.0.0.0/14", "192.68.0.0/24");
  221.  
  222. The result is a two-element array: 
  223. ("10.0.0.0-10.3.255.255", "192.68.0.0-192.68.0.255").
  224.  
  225.     @a=Net::CIDR::cidr2range("d08c:43::/32");
  226.  
  227. The result is a one-element array:
  228. ("d08c:43::-d08c:43:ffff:ffff:ffff:ffff:ffff:ffff").
  229.  
  230. cidr2range() does not merge adjacent or overlapping netblocks in
  231. @cidr_list.
  232.  
  233. =head2 @netblock_list = Net::CIDR::addr2cidr($address);
  234.  
  235. The addr2cidr function takes an IP address and returns a list of all
  236. the CIDR netblocks it might belong to:
  237.  
  238.     @a=Net::CIDR::addr2cidr('192.68.0.31');
  239.  
  240. The result is a thirtythree-element array:
  241. ('192.68.0.31/32', '192.68.0.30/31', '192.68.0.28/30', '192.68.0.24/29',
  242.  [and so on])
  243. consisting of all the possible subnets containing this address from
  244. 0.0.0.0/0 to address/32.
  245.  
  246. Any addresses supplied to addr2cidr after the first will be ignored.
  247. It works similarly for IPv6 addresses, returning a list of one hundred
  248. and twenty nine elements.
  249.  
  250. =head2 $cidr=Net::CIDR::addrandmask2cidr($address, $netmask);
  251.  
  252. The addrandmask2cidr function takes an IP address and a netmask, and
  253. returns the CIDR range whose size fits the netmask and which contains
  254. the address.  It is an error to supply one parameter in IPv4-ish
  255. format and the other in IPv6-ish format, and it is an error to supply
  256. a netmask which does not consist solely of 1 bits followed by 0 bits.
  257. For example, '255.255.248.192' is an invalid netmask, as is
  258. '255.255.255.32' because both contain 0 bits in between 1 bits.
  259.  
  260. Technically speaking both of those *are* valid netmasks, but a) you'd
  261. have to be insane to use them, and b) there's no corresponding CIDR
  262. range.
  263.  
  264. =cut
  265.  
  266. # CIDR to start-finish
  267.  
  268. sub cidr2range {
  269.     my @cidr=@_;
  270.  
  271.     my @r;
  272.  
  273.     while ($#cidr >= 0)
  274.     {
  275.     my $cidr=shift @cidr;
  276.  
  277.     $cidr =~ s/\s//g;
  278.  
  279.     unless ($cidr =~ /(.*)\/(.*)/)
  280.     {
  281.         push @r, $cidr;
  282.         next;
  283.     }
  284.  
  285.     my ($ip, $pfix)=($1, $2);
  286.  
  287.     my $isipv6;
  288.     ($isipv6, $ip)=_ipv6to4($ip);
  289.  
  290.     my @ips= split (/\.+/, $ip);
  291.     for( my $i = $#ips + 1 ; $i < 4 ; $i++ ) { $ips[$i] = 0; }
  292.  
  293.     grep {
  294.         croak "$_, as in '$cidr', is not a byte" unless $_ >= 0 && $_ <= 255 && $_ =~ /^[0-9]+$/;
  295.     } @ips;
  296.  
  297.     croak "$pfix, as in '$cidr', does not make sense"
  298.         unless $pfix >= 0 && $pfix <= ($#ips+1) * 8 && $pfix =~ /^[0-9]+$/;
  299.  
  300.     my @rr=_cidr2iprange($pfix, @ips);
  301.  
  302.     while ($#rr >= 0)
  303.     {
  304.         my $a=shift @rr;
  305.         my $b=shift @rr;
  306.  
  307.         $a =~ s/\.$//;
  308.         $b =~ s/\.$//;
  309.  
  310.         if ($isipv6)
  311.         {
  312.         $a=_ipv4to6($a);
  313.         $b=_ipv4to6($b);
  314.         }
  315.  
  316.         push @r, "$a-$b";
  317.     }
  318.     }
  319.  
  320.     return @r;
  321. }
  322.  
  323. #
  324. # If the input is an IPv6-formatted address, convert it to an IPv4 decimal
  325. # format, since the other functions know how to deal with it.  The hexadecimal
  326. # IPv6 address is represented in dotted-decimal form, like IPv4.
  327. #
  328.  
  329. sub _ipv6to4 {
  330.     my $ipv6=shift;
  331.  
  332.     return (undef, $ipv6) unless $ipv6 =~ /:/;
  333.  
  334.     croak "Syntax error: $ipv6"
  335.     unless $ipv6 =~ /^[a-fA-F0-9:\.]+$/;
  336.  
  337.     my $ip4_suffix="";
  338.  
  339.     ($ipv6, $ip4_suffix)=($1, $2)
  340.     if $ipv6 =~ /^(.*:)([0-9]+\.[0-9\.]+)$/;
  341.  
  342.     $ipv6 =~ s/([a-fA-F0-9]+)/_h62d($1)/ge;
  343.  
  344.     my $ipv6_suffix="";
  345.  
  346.     if ($ipv6 =~ /(.*)::(.*)/)
  347.     {
  348.     ($ipv6, $ipv6_suffix)=($1, $2);
  349.     $ipv6_suffix .= ".$ip4_suffix";
  350.     }
  351.     else
  352.     {
  353.     $ipv6 .= ".$ip4_suffix";
  354.     }
  355.  
  356.     my @p=grep (/./, split (/[^0-9]+/, $ipv6));
  357.  
  358.     my @s=grep (/./, split (/[^0-9]+/, $ipv6_suffix));
  359.  
  360.     push @p, 0 while $#p + $#s < 14;
  361.  
  362.     my $n=join(".", @p, @s);
  363.  
  364. #    return (undef, $1)
  365. #    if $n =~ /^0\.0\.0\.0\.0\.0\.0\.0\.0\.0\.255\.255\.(.*)$/;
  366.  
  367.     return (1, $n);
  368. }
  369.  
  370. # Let's go the other way around
  371.  
  372. sub _ipv4to6 {
  373.     my @octets=split(/[^0-9]+/, shift);
  374.  
  375.     croak "Internal error in _ipv4to6"
  376.     unless $#octets == 15;
  377.  
  378.     my @dummy=@octets;
  379.  
  380.     return ("::ffff:" . join(".", $octets[12], $octets[13], $octets[14], $octets[15]))
  381.     if join(".", splice(@dummy, 0, 12)) eq "0.0.0.0.0.0.0.0.0.0.255.255";
  382.  
  383.     my @words;
  384.  
  385.     my $i;
  386.  
  387.     for ($i=0; $i < 8; $i++)
  388.     {
  389.     $words[$i]=sprintf("%x", $octets[$i*2] * 256 + $octets[$i*2+1]);
  390.     }
  391.  
  392.     my $ind= -1;
  393.     my $indlen= -1;
  394.  
  395.     for ($i=0; $i < 8; $i++)
  396.     {
  397.     next unless $words[$i] eq "0";
  398.  
  399.     my $j;
  400.  
  401.     for ($j=$i; $j < 8; $j++)
  402.     {
  403.         last if $words[$j] ne "0";
  404.     }
  405.  
  406.     if ($j - $i > $indlen)
  407.     {
  408.         $indlen= $j-$i;
  409.         $ind=$i;
  410.         $i=$j-1;
  411.     }
  412.     }
  413.  
  414.     return "::" if $indlen == 8;
  415.  
  416.     return join(":", @words) if $ind < 0;
  417.  
  418.     my @s=splice (@words, $ind+$indlen);
  419.  
  420.     return join(":", splice (@words, 0, $ind)) . "::"
  421.     . join(":", @s);
  422. }
  423.     
  424. sub _h62d {
  425.     my $h=shift;
  426.  
  427.     $h=hex("0x$h");
  428.  
  429.     return ( int($h / 256) . "." . ($h % 256));
  430. }
  431.  
  432. sub _cidr2iprange {
  433.     my @ips=@_;
  434.     my $pfix=shift @ips;
  435.  
  436.     if ($pfix == 0)
  437.     {
  438.     grep { $_=0 } @ips;
  439.  
  440.     my @ips2=@ips;
  441.  
  442.     grep { $_=255 } @ips2;
  443.  
  444.     return ( join(".", @ips), join(".", @ips2));
  445.     }
  446.  
  447.     if ($pfix >= 8)
  448.     {
  449.     my $octet=shift @ips;
  450.  
  451.     @ips=_cidr2iprange($pfix - 8, @ips);
  452.  
  453.     grep { $_="$octet.$_"; } @ips;
  454.     return @ips;
  455.     }
  456.  
  457.     my $octet=shift @ips;
  458.  
  459.     grep { $_=0 } @ips;
  460.  
  461.     my @ips2=@ips;
  462.  
  463.     grep { $_=255 } @ips2;
  464.  
  465.     my @r= _cidr2range8(($octet, $pfix));
  466.  
  467.     $r[0] = join (".", ($r[0], @ips));
  468.     $r[1] = join (".", ($r[1], @ips2));
  469.  
  470.     return @r;
  471. }
  472.  
  473. #
  474. # ADDRESS to list of CIDR netblocks
  475. #
  476.  
  477. sub addr2cidr {
  478.     my(@blocks, $address, $bitmask, $net, $octetstash) = ();
  479.     my($isIPv6, $addr) = _ipv6to4(shift);
  480.     my $bitsInAddress = ($isIPv6)?128:32;
  481.  
  482.     # create BigInts if necessary.  Straight assignment of ints to
  483.     # BigInts breaks BigInt-ness hence the bizarre subtractions later.
  484.     if($isIPv6) {
  485.         $address = new Math::BigInt 0;
  486.         $bitmask = new Math::BigInt 0;
  487.         $net = new Math::BigInt 0;
  488.         $octetstash = new Math::BigInt 0;
  489.     } else { ($address, $bitmask, $net, $octetstash) = (0, 0, 0, 0); }
  490.  
  491.     # convert dotted-octets into an int (or BigInt)
  492.     do { $address = $address << 8; $address = $address + $_ }
  493.         for split(/\./, $addr);
  494.  
  495.     foreach my $bits (reverse 0..$bitsInAddress) {
  496.         $octetstash = $octetstash - $octetstash + 255;
  497.         $bitmask = $bitmask - $bitmask;
  498.         for(1 .. $bits) { $bitmask = ($bitmask << 1) + 1; }
  499.         $bitmask = $bitmask << ($bitsInAddress - $bits);
  500.         
  501.         $net = $address & $bitmask;
  502.         push @blocks, (map { $_ =~ s/\+//; (($isIPv6)?_ipv4to6($_):$_) }
  503.             join('.', reverse map {
  504.             my $temp = ($octetstash & $net) >> ($_ * 8);
  505.             $octetstash = $octetstash << 8;
  506.             $temp;
  507.             } (0 .. $bitsInAddress / 8 - 1)
  508.         ))[0]."/$bits";
  509.     }
  510.     return @blocks;
  511. }
  512.  
  513. # Address and netmask to CIDR
  514.  
  515. sub addrandmask2cidr {
  516.         my $address = shift;
  517.     my($a_isIPv6) = _ipv6to4($address);
  518.         my($n_isIPv6, $netmask) = _ipv6to4(shift);
  519.     die("Both address and netmask must be the same type")
  520.         if( defined($a_isIPv6) && defined($n_isIPv6) && $a_isIPv6 != $n_isIPv6);
  521.         my $bitsInNetmask = 0;
  522.         my $previousNMoctet = 255;
  523.         foreach my $octet (split/\./, $netmask) {
  524.             die("Invalid netmask") if($previousNMoctet != 255 && $octet != 0);
  525.             $previousNMoctet = $octet;
  526.         $bitsInNetmask +=
  527.         ($octet == 255) ? 8 :
  528.         ($octet == 254) ? 7 :
  529.         ($octet == 252) ? 6 :
  530.         ($octet == 248) ? 5 :
  531.         ($octet == 240) ? 4 :
  532.         ($octet == 224) ? 3 :
  533.         ($octet == 192) ? 2 :
  534.         ($octet == 128) ? 1 :
  535.         ($octet == 0) ? 0 :
  536.                 die("Invalid netmask");
  537.     }
  538.         return (grep { /\/$bitsInNetmask$/ } addr2cidr($address))[0];
  539. }
  540.  
  541. #
  542. # START-FINISH to CIDR list
  543. #
  544.  
  545. sub range2cidr {
  546.     my @r=@_;
  547.  
  548.     my $i;
  549.  
  550.     my @c;
  551.  
  552.     for ($i=0; $i <= $#r; $i++)
  553.     {
  554.     $r[$i] =~ s/\s//g;
  555.  
  556.     if ($r[$i] =~ /\//)
  557.     {
  558.         push @c, $r[$i];
  559.         next;
  560.     }
  561.  
  562.     $r[$i]="$r[$i]-$r[$i]" unless $r[$i] =~ /(.*)-(.*)/;
  563.  
  564.     $r[$i] =~ /(.*)-(.*)/;
  565.  
  566.     my ($a,$b)=($1,$2);
  567.  
  568.     my $isipv6_1;
  569.     my $isipv6_2;
  570.  
  571.     ($isipv6_1, $a)=_ipv6to4($a);
  572.     ($isipv6_2, $b)=_ipv6to4($b);
  573.  
  574.     if ($isipv6_1 || $isipv6_2)
  575.     {
  576.         croak "Invalid netblock range: $r[$i]"
  577.         unless $isipv6_1 && $isipv6_2;
  578.     }
  579.  
  580.     my @a=split(/\.+/, $a);
  581.     my @b=split(/\.+/, $b);
  582.  
  583.     croak unless $#a == $#b;
  584.  
  585.     my @cc=_range2cidr(\@a, \@b);
  586.  
  587.     while ($#cc >= 0)
  588.     {
  589.         $a=shift @cc;
  590.         $b=shift @cc;
  591.  
  592.         $a=_ipv4to6($a) if $isipv6_1;
  593.  
  594.         push @c, "$a/$b";
  595.     }
  596.     }
  597.     return @c unless(1==@r && 1==@c && !wantarray());
  598.     return $c[0];
  599. }
  600.  
  601. sub _range2cidr {
  602.     my $a=shift;
  603.     my $b=shift;
  604.  
  605.     my @a=@$a;
  606.     my @b=@$b;
  607.  
  608.     $a=shift @a;
  609.     $b=shift @b;
  610.  
  611.     return _range2cidr8($a, $b) if $#a < 0; # Least significant octet pair.
  612.  
  613.     croak unless $a >= 0 && $a <= 255 && $a =~ /^[0-9]+$/;
  614.     croak unless $b >= 0 && $b <= 255 && $b =~ /^[0-9]+$/ && $b >= $a;
  615.  
  616.     my @c;
  617.  
  618.     if ($a == $b) # Same start/end octet
  619.     {
  620.     my @cc= _range2cidr(\@a, \@b);
  621.  
  622.     while ($#cc >= 0)
  623.     {
  624.         my $c=shift @cc;
  625.  
  626.         push @c, "$a.$c";
  627.  
  628.         $c=shift @cc;
  629.         push @c, $c+8;
  630.     }
  631.     return @c;
  632.     }
  633.  
  634.     my $start0=1;
  635.     my $end255=1;
  636.  
  637.     grep { $start0=0 unless $_ == 0; } @a;
  638.     grep { $end255=0 unless $_ == 255; } @b;
  639.  
  640.     if ( ! $start0 )
  641.     {
  642.     my @bcopy=@b;
  643.  
  644.     grep { $_=255 } @bcopy;
  645.  
  646.     my @cc= _range2cidr(\@a, \@bcopy);
  647.  
  648.     while ($#cc >= 0)
  649.     {
  650.         my $c=shift @cc;
  651.  
  652.         push @c, "$a.$c";
  653.  
  654.         $c=shift @cc;
  655.         push @c, $c + 8;
  656.     }
  657.  
  658.     ++$a;
  659.     }
  660.  
  661.     if ( ! $end255 )
  662.     {
  663.     my @acopy=@a;
  664.  
  665.     grep { $_=0 } @acopy;
  666.  
  667.     my @cc= _range2cidr(\@acopy, \@b);
  668.  
  669.     while ($#cc >= 0)
  670.     {
  671.         my $c=shift @cc;
  672.  
  673.         push @c, "$b.$c";
  674.  
  675.         $c=shift @cc;
  676.         push @c, $c + 8;
  677.     }
  678.  
  679.     --$b;
  680.     }
  681.  
  682.     if ($a <= $b)
  683.     {
  684.     grep { $_=0 } @a;
  685.  
  686.     my $pfix=join(".", @a);
  687.  
  688.     my @cc= _range2cidr8($a, $b);
  689.  
  690.     while ($#cc >= 0)
  691.     {
  692.         my $c=shift @cc;
  693.  
  694.         push @c, "$c.$pfix";
  695.  
  696.         $c=shift @cc;
  697.         push @c, $c;
  698.     }
  699.     }
  700.     return @c;
  701. }
  702.  
  703. sub _range2cidr8 {
  704.  
  705.     my @c;
  706.  
  707.     my @r=@_;
  708.  
  709.     while ($#r >= 0)
  710.     {
  711.     my $a=shift @r;
  712.     my $b=shift @r;
  713.  
  714.     croak unless $a >= 0 && $a <= 255 && $a =~ /^[0-9]+$/;
  715.     croak unless $b >= 0 && $b <= 255 && $b =~ /^[0-9]+$/ && $b >= $a;
  716.  
  717.     ++$b;
  718.  
  719.     while ($a < $b)
  720.     {
  721.         my $i=0;
  722.         my $n=1;
  723.  
  724.         while ( ($n & $a) == 0)
  725.         {
  726.         ++$i;
  727.         $n <<= 1;
  728.         last if $i >= 8;
  729.         }
  730.  
  731.         while ($i && $n + $a > $b)
  732.         {
  733.         --$i;
  734.         $n >>= 1;
  735.         }
  736.  
  737.         push @c, $a;
  738.         push @c, 8-$i;
  739.  
  740.         $a += $n;
  741.     }
  742.     }
  743.  
  744.     return @c;
  745. }
  746.  
  747. sub _cidr2range8 {
  748.  
  749.     my @c=@_;
  750.  
  751.     my @r;
  752.  
  753.     while ($#c >= 0)
  754.     {
  755.     my $a=shift @c;
  756.     my $b=shift @c;
  757.  
  758.     croak unless $a >= 0 && $a <= 255 && $a =~ /^[0-9]+$/;
  759.     croak unless $b >= 0 && $b <= 8 && $b =~ /^[0-9]+$/;
  760.  
  761.     my $n= 1 << (8-$b);
  762.  
  763.     $a &= ($n-1) ^ 255;
  764.  
  765.     push @r, $a;
  766.     push @r, $a + ($n-1);
  767.     }
  768.     return @r;
  769. }
  770.  
  771. sub _ipcmp {
  772.     my $aa=shift;
  773.     my $bb=shift;
  774.  
  775.     my $isipv6_1;
  776.     my $isipv6_2;
  777.  
  778.     ($isipv6_1, $aa)=_ipv6to4($aa);
  779.     ($isipv6_2, $bb)=_ipv6to4($bb);
  780.  
  781.     if ($isipv6_1 || $isipv6_2)
  782.     {
  783.     croak "Invalid netblock: $aa-$bb"
  784.         unless $isipv6_1 && $isipv6_2;
  785.     }
  786.  
  787.     my @a=split (/\./, $aa);
  788.     my @b=split (/\./, $bb);
  789.  
  790.     croak unless $#a == $#b;
  791.  
  792.     while ($#a >= 0 && $a[0] == $b[0])
  793.     {
  794.     shift @a;
  795.     shift @b;
  796.     }
  797.  
  798.     return 0 if $#a < 0;
  799.  
  800.     return $a[0] <=> $b[0];
  801. }
  802.  
  803.  
  804. =pod
  805.  
  806. =head2 @octet_list=Net::CIDR::cidr2octets(@cidr_list);
  807.  
  808. cidr2octets() takes @cidr_list and returns a list of leading octets
  809. representing those netblocks.  Example:
  810.  
  811.     @octet_list=Net::CIDR::cidr2octets("10.0.0.0/14", "192.68.0.0/24");
  812.  
  813. The result is the following five-element array:
  814. ("10.0", "10.1", "10.2", "10.3", "192.68.0").
  815.  
  816. For IPv6 addresses, the hexadecimal words in the resulting list are
  817. zero-padded:
  818.  
  819.     @octet_list=Net::CIDR::cidr2octets("::dead:beef:0:0/110");
  820.  
  821. The result is a four-element array:
  822. ("0000:0000:0000:0000:dead:beef:0000",
  823. "0000:0000:0000:0000:dead:beef:0001",
  824. "0000:0000:0000:0000:dead:beef:0002",
  825. "0000:0000:0000:0000:dead:beef:0003").
  826. Prefixes of IPv6 CIDR blocks should be even multiples of 16 bits, otherwise
  827. they can potentially expand out to a 32,768-element array, each!
  828.  
  829. =cut
  830.  
  831. sub cidr2octets {
  832.     my @cidr=@_;
  833.  
  834.     my @r;
  835.  
  836.     while ($#cidr >= 0)
  837.     {
  838.     my $cidr=shift @cidr;
  839.  
  840.     $cidr =~ s/\s//g;
  841.  
  842.     croak unless ($cidr =~ /(.*)\/(.*)/);
  843.  
  844.     my ($ip, $pfix)=($1, $2);
  845.  
  846.     my $isipv6;
  847.  
  848.     ($isipv6, $ip)=_ipv6to4($ip);
  849.  
  850.     my @ips= split (/\.+/, $ip);
  851.     for( my $i = $#ips + 1 ; $i < 4 ; $i++ ) { $ips[$i] = 0; }
  852.  
  853.     grep {
  854.         croak "$_, as in '$cidr', is not a byte" unless $_ >= 0 && $_ <= 255 && $_ =~ /^[0-9]+$/;
  855.     } @ips;
  856.  
  857.     croak "$pfix, as in '$cidr', does not make sense"
  858.         unless $pfix >= 0 && $pfix <= ($#ips+1) * 8 && $pfix =~ /^[0-9]+$/;
  859.  
  860.     my $i;
  861.  
  862.     for ($i=0; $i <= $#ips; $i++)
  863.     {
  864.         last if $pfix - $i * 8 < 8;
  865.     }
  866.  
  867.     my @msb=splice @ips, 0, $i;
  868.  
  869.     my $bitsleft= $pfix - $i * 8;
  870.  
  871.     if ($#ips < 0 || $bitsleft == 0)
  872.     {
  873.         if ($pfix == 0 && $bitsleft == 0)
  874.         {
  875.         foreach (0..255)
  876.         {
  877.             my @n=($_);
  878.  
  879.             if ($isipv6)
  880.             {
  881.             _push_ipv6_octets(\@r, \@n);
  882.             }
  883.             else
  884.             {
  885.             push @r, $n[0];
  886.             }
  887.         }
  888.         }
  889.         elsif ($isipv6)
  890.         {
  891.         _push_ipv6_octets(\@r, \@msb);
  892.         }
  893.         else
  894.         {
  895.         push @r, join(".", @msb);
  896.         }
  897.         next;
  898.     }
  899.  
  900.     my @rr=_cidr2range8(($ips[0], $bitsleft));
  901.  
  902.     while ($#rr >= 0)
  903.     {
  904.         my $a=shift @rr;
  905.         my $b=shift @rr;
  906.  
  907.         grep {
  908.         if ($isipv6)
  909.         {
  910.             push @msb, $_;
  911.             _push_ipv6_octets(\@r, \@msb);
  912.             pop @msb;
  913.         }
  914.         else
  915.         {
  916.             push @r, join(".", (@msb, $_));
  917.         }
  918.         } ($a .. $b);
  919.     }
  920.     }
  921.  
  922.     return @r;
  923. }
  924.  
  925. sub _push_ipv6_octets {
  926.     my $ary_ref=shift;
  927.     my $octets=shift;
  928.  
  929.     if ( ($#{$octets} % 2) == 0)    # Odd number of octets
  930.     {
  931.     foreach (0 .. 255)
  932.     {
  933.         push @$octets, $_;
  934.         _push_ipv6_octets($ary_ref, $octets);
  935.         pop @$octets;
  936.     }
  937.     return;
  938.     }
  939.  
  940.     my $i;
  941.     my $s="";
  942.  
  943.     for ($i=0; $i <= $#{$octets}; $i += 2)
  944.     {
  945.     $s .= ":" if $s ne "";
  946.     $s .= sprintf("%02x%02x", $$octets[$i], $$octets[$i+1]);
  947.     }
  948.     push @$ary_ref, $s;
  949. }
  950.  
  951. =pod
  952.  
  953. =head2 @cidr_list=Net::CIDR::cidradd($block, @cidr_list);
  954.  
  955. The cidradd() functions allows a CIDR list to be built one CIDR netblock
  956. at a time, merging adjacent and overlapping ranges.
  957. $block is a single netblock, expressed as either "start-finish", or
  958. "address/prefix".
  959. Example:
  960.  
  961.     @cidr_list=Net::CIDR::range2cidr("192.68.0.0-192.68.0.255");
  962.     @cidr_list=Net::CIDR::cidradd("10.0.0.0/8", @cidr_list);
  963.     @cidr_list=Net::CIDR::cidradd("192.68.1.0-192.68.1.255", @cidr_list);
  964.                   
  965. The result is a two-element array: ("10.0.0.0/8", "192.68.0.0/23").
  966. IPv6 addresses are handled in an analogous fashion.
  967.  
  968. =cut
  969.  
  970. sub cidradd {
  971.     my @cidr=@_;
  972.  
  973.     my $ip=shift @cidr;
  974.  
  975.     $ip="$ip-$ip" unless $ip =~ /[-\/]/;
  976.  
  977.     unshift @cidr, $ip;
  978.  
  979.     @cidr=cidr2range(@cidr);
  980.  
  981.     my @a;
  982.     my @b;
  983.  
  984.     grep {
  985.     croak unless /(.*)-(.*)/;
  986.     push @a, $1;
  987.     push @b, $2;
  988.     } @cidr;
  989.  
  990.     my $lo=shift @a;
  991.     my $hi=shift @b;
  992.  
  993.     my $i;
  994.  
  995.     for ($i=0; $i <= $#a; $i++)
  996.     {
  997.     last if _ipcmp($lo, $hi) > 0;
  998.  
  999.     next if _ipcmp($b[$i], $lo) < 0;
  1000.     next if _ipcmp($hi, $a[$i]) < 0;
  1001.  
  1002.     if (_ipcmp($a[$i],$lo) <= 0 && _ipcmp($hi, $b[$i]) <= 0)
  1003.     {
  1004.         $lo=_add1($hi);
  1005.         last;
  1006.     }
  1007.  
  1008.     if (_ipcmp($a[$i],$lo) <= 0)
  1009.     {
  1010.         $lo=_add1($b[$i]);
  1011.         next;
  1012.     }
  1013.  
  1014.     if (_ipcmp($hi, $b[$i]) <= 0)
  1015.     {
  1016.         $hi=_sub1($a[$i]);
  1017.         next;
  1018.     }
  1019.  
  1020.     $a[$i]=undef;
  1021.     $b[$i]=undef;
  1022.     }
  1023.  
  1024.     unless ((! defined $lo) || (! defined $hi) || _ipcmp($lo, $hi) > 0)
  1025.     {
  1026.     push @a, $lo;
  1027.     push @b, $hi;
  1028.     }
  1029.  
  1030.     @cidr=();
  1031.  
  1032.     @a=grep ( (defined $_), @a);
  1033.     @b=grep ( (defined $_), @b);
  1034.  
  1035.     for ($i=0; $i <= $#a; $i++)
  1036.     {
  1037.     push @cidr, "$a[$i]-$b[$i]";
  1038.     }
  1039.  
  1040.     @cidr=sort {
  1041.     $a =~ /(.*)-/;
  1042.  
  1043.     my $c=$1;
  1044.  
  1045.     $b =~ /(.*)-/;
  1046.  
  1047.     my $d=$1;
  1048.  
  1049.     my $e=_ipcmp($c, $d);
  1050.     return $e;
  1051.     } @cidr;
  1052.  
  1053.     $i=0;
  1054.  
  1055.     while ($i < $#cidr)
  1056.     {
  1057.     $cidr[$i] =~ /(.*)-(.*)/;
  1058.  
  1059.     my ($k, $l)=($1, $2);
  1060.  
  1061.     $cidr[$i+1] =~ /(.*)-(.*)/;
  1062.  
  1063.     my ($m, $n)=($1, $2);
  1064.  
  1065.     if (_ipcmp( _add1($l), $m) == 0)
  1066.     {
  1067.         splice @cidr, $i, 2, "$k-$n";
  1068.         next;
  1069.     }
  1070.     ++$i;
  1071.     }
  1072.  
  1073.     return range2cidr(@cidr);
  1074. }
  1075.  
  1076.  
  1077. sub _add1 {
  1078.     my $n=shift;
  1079.  
  1080.     my $isipv6;
  1081.  
  1082.     ($isipv6, $n)=_ipv6to4($n);
  1083.  
  1084.     my @ip=split(/\./, $n);
  1085.  
  1086.     my $i=$#ip;
  1087.  
  1088.     while ($i >= 0)
  1089.     {
  1090.     last if ++$ip[$i] < 256;
  1091.     $ip[$i]=0;
  1092.     --$i;
  1093.     }
  1094.  
  1095.     return undef if $i < 0;
  1096.  
  1097.     $i=join(".", @ip);
  1098.     $i=_ipv4to6($i) if $isipv6;
  1099.     return $i;
  1100.  
  1101. }
  1102.  
  1103. sub _sub1 {
  1104.     my $n=shift;
  1105.  
  1106.     my $isipv6;
  1107.  
  1108.     ($isipv6, $n)=_ipv6to4($n);
  1109.  
  1110.     my @ip=split(/\./, $n);
  1111.  
  1112.     my $i=$#ip;
  1113.  
  1114.     while ($i >= 0)
  1115.     {
  1116.     last if --$ip[$i] >= 0;
  1117.     $ip[$i]=255;
  1118.     --$i;
  1119.     }
  1120.  
  1121.     return undef if $i < 0;
  1122.  
  1123.     $i=join(".", @ip);
  1124.     $i=_ipv4to6($i) if $isipv6;
  1125.     return $i;
  1126. }
  1127.  
  1128. =pod
  1129.  
  1130. =head2 $found=Net::CIDR::cidrlookup($ip, @cidr_list);
  1131.  
  1132. Search for $ip in @cidr_list.  $ip can be a single IP address, or a
  1133. netblock in CIDR or start-finish notation.
  1134. lookup() returns 1 if $ip overlaps any netblock in @cidr_list, 0 if not.
  1135.  
  1136. =cut
  1137.  
  1138. sub cidrlookup {
  1139.     my @cidr=@_;
  1140.  
  1141.     my $ip=shift @cidr;
  1142.  
  1143.     $ip="$ip-$ip" unless $ip =~ /[-\/]/;
  1144.  
  1145.     unshift @cidr, $ip;
  1146.  
  1147.     @cidr=cidr2range(@cidr);
  1148.  
  1149.     my @a;
  1150.     my @b;
  1151.  
  1152.     grep {
  1153.     croak unless /(.*)-(.*)/;
  1154.     push @a, $1;
  1155.     push @b, $2;
  1156.     } @cidr;
  1157.  
  1158.     my $lo=shift @a;
  1159.     my $hi=shift @b;
  1160.  
  1161.     my $i;
  1162.  
  1163.     for ($i=0; $i <= $#a; $i++)
  1164.     {
  1165.     next if _ipcmp($b[$i], $lo) < 0;
  1166.     next if _ipcmp($hi, $a[$i]) < 0;
  1167.     return 1;
  1168.     }
  1169.  
  1170.     return 0;
  1171. }
  1172.  
  1173. =pod
  1174.  
  1175. =head2 $ip=Net::CIDR::cidrvalidate($ip);
  1176.  
  1177. Validate whether $ip is a valid IPv4 or IPv6 address.
  1178. Returns its argument or undef.
  1179. Spaces are removed, and IPv6 hexadecimal address are converted to lowercase.
  1180.  
  1181. =cut
  1182.  
  1183. sub cidrvalidate {
  1184.     my $v=shift;
  1185.  
  1186.     $v =~ s/\s//g;
  1187.  
  1188.     $v=lc($v);
  1189.  
  1190.     if ($v =~ /^([0-9\.]+)$/ || $v =~ /^::ffff:([0-9\.]+)$/ ||
  1191.     $v =~ /^:([0-9\.]+)$/)
  1192.     {
  1193.     my $n=$1;
  1194.  
  1195.     return undef if $n =~ /^\./ || $n =~ /\.$/ || $n =~ /\.\./;
  1196.  
  1197.     my @o= split(/\./, $n);
  1198.  
  1199.     return undef if $#o != 3;
  1200.  
  1201.     foreach (@o)
  1202.     {
  1203.         return if /^0./;
  1204.         return if $_ < 0 || $_ > 255;
  1205.     }
  1206.     return $v;
  1207.     }
  1208.  
  1209.     return undef unless $v =~ /^[0-9a-f:]+$/;
  1210.  
  1211.     return undef if $v =~ /:::/ || $v =~ /^:[^:]/ || $v =~ /[^:]:$/
  1212.     || $v =~ /::.*::/;
  1213.  
  1214.     my @o=grep (/./, split(/:/, $v));
  1215.  
  1216.     return undef if ($#o >= 8 || ($#o<7 && $v !~ /::/));
  1217.  
  1218.     foreach (@o)
  1219.     {
  1220.     return undef if length ($_) > 4;
  1221.     }
  1222.  
  1223.     return $v;
  1224. }
  1225.  
  1226. =pod
  1227.  
  1228. =head1 BUGS
  1229.  
  1230. Garbage in, garbage out.
  1231. Always use validate() before doing anything with untrusted input.
  1232. Otherwise,
  1233. "slightly" invalid input will work (extraneous whitespace
  1234. is generally OK),
  1235. but the functions will croak if you're totally off the wall.
  1236.  
  1237. =head1 AUTHOR
  1238.  
  1239. Sam Varshavchik <sam@email-scan.com>
  1240.  
  1241. With some contributions from David Cantrell <david@cantrell.org.uk>
  1242.  
  1243. =cut
  1244.  
  1245. __END__
  1246.